home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Turnbull China Bikeride
/
Turnbull China Bikeride - Disc 2.iso
/
STUTTGART
/
LANG
/
LISP
/
XLISP
/
XLISP21S
/
sources
/
c
/
arcstuf
< prev
next >
Wrap
Text File
|
1992-07-09
|
35KB
|
1,377 lines
/* Arcstuff.c
* Archimedes RISC OS specific frontend routines for XLisp.
* written by Gunnar Zoetl (gunnar@fasel.robin.de)
*/
#include <stdio.h>
#include <stdlib.h>
#include <math.h>
#include <string.h>
#include <ctype.h>
#include <signal.h>
#include <time.h>
#include "kernel.h"
#include "os.h"
#include "bbc.h"
#include "xlisp.h"
/*+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
+*++++++++++++++++++++++ WIMP interfacing code ++++++++++++++++++++++++++++
+*+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++*/
#include "wimp.h"
#include "wimpt.h"
#include "win.h"
#include "event.h"
#include "res.h"
#include "werr.h"
#include "template.h"
#include "dbox.h"
/* structure to hold screen size and log.-to-phys.-coord. translation info */
typedef struct _svar {
int xeigh; /* translation factors */
int yeigh;
int xphys; /* physical resolution */
int yphys;
int xppc; /* pixels per char */
int yppc;
} screenvar;
/* structure for times emulation */
struct tms {
time_t tms_utime;
time_t tms_stime;
time_t tms_cutime;
time_t tms_cstime;
};
/* menu entries */
#define XF_INFO 1
#define XF_QUIT 2
/* icons in dialog box for the info fields */
#define XF_XL_INFO 5
#define XF_XF_INFO 6
/* misc defines */
#define ReadModeVar 53
#define ReadVDUvar 49
#define XEIGH 4
#define YEIGH 5
#define XSIZE 11
#define YSIZE 12
#define CARET 40 /* 40 OS_units heigth */
#define HZ 100
#define PATHBUF 256
#define FILENAMELEN 32
#define WSTDMASK wimp_EMPTRENTER | wimp_EMPTRLEAVE
#define WKEYMASK WSTDMASK | wimp_EMNULL
#define max(a,b) (a>b?a:b)
#define min(a,b) (a<b?a:b)
/*** global variables: ***/
static int winfo_buffer[1024]; /* for wimp_get_wind_info() calls */
static wimp_t task_handle;
static wimp_w xf_main_wind;
static menu xf_menu;
static int colors;
static BOOL initing;
static struct tms systime;
static time_t sys_timeslp;
/* filepaths */
char *loadpath = NULL;
char *curdir = NULL;
/* redraw info */
static int xf_needs_redraw = FALSE;
static int r_xmin = 32768;
static int r_xmax = 0;
static int r_ymin = 32768;
static int r_ymax = 0;
/* phys. mode info */
static int max_x_size;
static int max_y_size;
static char* screen;
static int xf_cursor_x;
static int xf_cursor_y;
static int char_x_size;
static int char_y_size;
/* ringbuffer for keyboard input */
static struct keybuf {
int first;
int last;
int count;
int chars[BUFSIZ];
} keybuffer;
/* Wimp version number we know about *100 */
static int wimp_version = 200;
/* pump up the initial stack */
int __root_stack_size = 128 * 1024;
/* the info fields */
static char *xl_version = "XLisp 2.1d (02 Jan 1992)";
static char *xf_version = "Frontend 0.13 (09 Jul 1992)";
/* and some forward declarations */
int xf_w_open_window (wimp_openstr *);
void xf_clear_screen(void);
/*** general routines ***/
/* convert a string to lower case */
char *stolower(char *bla)
{
char *bli, *blu;
int i;
if (bla == NULL || strlen(bla) == 0)
return bla;
bli = malloc(strlen(bla) + 1);
blu = bli;
for(i = 0; i <= strlen(bla); i++)
bli[i] = (char) tolower(bla[i]);
return blu;
}
/* duplicate a string */
char *strdup(char *from)
{
char *to;
to = malloc(strlen(from) + 1);
return(strcpy(to, from));
}
/* get time from 100Hz clock */
long get_time(void)
{
char timbuf[5];
_kernel_osword(1, (int *)timbuf);
/* return only low 4 bytes of time. */
return (long) (timbuf[0] + (timbuf[1]<<8) + (timbuf[2]<<16) + (timbuf[3]<<24));
}
/* init keybuffer */
void init_keybuffer(void)
{
keybuffer.first = 0;
keybuffer.last = 0;
keybuffer.count = 0;
}
/* push one keypress onto buffer, do nothing if buffer overflow */
void pushkey(int key)
{
if (keybuffer.count < BUFSIZ)
{
keybuffer.chars[keybuffer.last] = key;
keybuffer.last = (keybuffer.last + 1) % BUFSIZ;
keybuffer.count++;
}
}
/* pop a keypress from buffer, return -1 if empty */
int popkey(void)
{
int tmpkey;
if (keybuffer.count > 0)
{
tmpkey = keybuffer.chars[keybuffer.first];
keybuffer.first = (keybuffer.first + 1) % BUFSIZ;
keybuffer.count--;
}
else
tmpkey = -1;
return tmpkey;
}
/* handle a keypress, translate keycodes, handle escape key */
void xf_handle_key(int chcode)
{
switch (chcode)
{
case 27:
raise(SIGINT);
break;
default:
pushkey(chcode);
}
}
/* get physical screen size */
screenvar *xf_get_screen_size(void)
{
int *ssize;
int xp[3];
ssize = (int *)malloc(sizeof(struct _svar));
/* get translation info */
ssize[0] = bbc_modevar(-1, XEIGH);
ssize[1] = bbc_modevar(-1, YEIGH);
/* get max. x- and y-coordinates from OS */
ssize[2] = bbc_modevar(-1, XSIZE);
ssize[3] = bbc_modevar(-1, YSIZE);
/* get x/y pix. per char */
xp[0] = 162; /* x size of char */
xp[1] = 163; /* y */
xp[2] = -1; /* end of table */
bbc_vduvars (xp, xp);
ssize[4] = xp[0];
ssize[5] = xp[1];
/* while we're at it: set char sizes */
char_x_size = ssize[4] << ssize[0];
char_y_size = ssize[5] << ssize[1];
return (screenvar *)ssize;
}
/* adjust scrollbar positions if caret outside of vis. window area */
void xf_adjust_posn(wimp_caretstr *pos)
{
wimp_wstate wstate;
int vis_x_min, vis_x_max;
int vis_y_min, vis_y_max;
int xsize, ysize;
int dx, dy;
wimp_box wbox;
dx = dy = -32768;
wimp_get_wind_state(pos->w, &wstate);
/* get visible Part of work area */
xsize = wstate.o.box.x1 - wstate.o.box.x0;
ysize = wstate.o.box.y1 - wstate.o.box.y0;
vis_x_min = wstate.o.x;
vis_y_max = wstate.o.y;
vis_x_max = wstate.o.x + xsize;
vis_y_min = wstate.o.y - ysize;
/* get direction to scroll */
if (pos->x < vis_x_min)
dx = max(0, pos->x - xsize / 2);
if (pos->x > vis_x_max - char_x_size)
dx = min(max_x_size * char_x_size - xsize, pos->x - xsize / 2);
if (pos->y >= vis_y_max - CARET - 4)
dy = min(0, pos->y + CARET);
if (pos->y < vis_y_min)
dy = pos->y + ysize;
/* scroll window thru vis. part in necessary */
if (dx > -32768 || dy > -32768)
{
wbox.x0 = 0;
wbox.y1 = 0;
wbox.x1 = max_x_size * char_x_size;
wbox.y0 = -max_y_size * char_y_size;
/* default values for unset d*'s */
if (dx == -32768)
dx = wstate.o.x;
if (dy == -32768)
dy = wstate.o.y;
wimp_blockcopy(wstate.o.w, &wbox, dx - wstate.o.x, - dy - wstate.o.y);
wstate.o.x = dx;
wstate.o.y = dy;
wimp_open_wind(&wstate.o);
}
}
/* set caret, low level */
void xf_w_set_caret(BOOL force_vis)
{
wimp_caretstr posn;
if (wimp_get_caret_pos(&posn) == NULL)
if (posn.w == xf_main_wind || initing)
{
posn.x = xf_cursor_x * char_x_size;
posn.y = - xf_cursor_y * char_y_size - (CARET & 0xffff);
posn.w = xf_main_wind;
posn.i = -1;
posn.height = CARET;
/* watch out for caret inside visible part of window */
if (force_vis)
xf_adjust_posn(&posn);
wimp_set_caret_pos(&posn);
}
}
/* set caret, don't force visibility */
void xf_set_caret(void)
{
xf_w_set_caret(FALSE);
}
/* set caret, make visible */
void xf_find_caret(void)
{
xf_w_set_caret(TRUE);
}
/* task closedown */
void xf_closedown(void)
{
wimp_close_wind(xf_main_wind);
win_activedec();
wimp_taskclose(task_handle);
}
/* program info */
void xf_prog_info(void)
{
dbox window;
if ((window = dbox_new("ProgInfo")) != 0)
{
/* insert version strings */
dbox_setfield (window, XF_XL_INFO, xl_version);
dbox_setfield (window, XF_XF_INFO, xf_version);
dbox_show(window);
/* keep on screen as long as needed */
dbox_fillin(window);
/* then get rid of it */
dbox_dispose(&window);
}
}
/* event_process()-routine with caring for the actual runtime */
void xf_event_process(void)
{
systime.tms_utime += get_time() - sys_timeslp;
event_process();
sys_timeslp = get_time();
}
/*** virtual screen routines ***/
/* invalidate protions of the logical screen */
void xf_invalidate_screen(int x0, int y0, int x1, int y1)
{
/* adjust rectangle to be redrawn */
if (x0 < r_xmin)
r_xmin = x0;
if (y0 < r_ymin)
r_ymin = y0;
if (x1 > r_xmax)
r_xmax = x1;
if (y1 > r_ymax)
r_ymax = y1;
xf_needs_redraw = TRUE;
}
/* force redraw of altered portions (= window update) */
void xf_force_redraw(void)
{
wimp_redrawstr winr;
if (xf_needs_redraw)
{
/* build rectangle to redraw */
winr.w = xf_main_wind;
winr.box.x0 = r_xmin * char_x_size;
winr.box.x1 = (r_xmax + 1) * char_x_size;
winr.box.y0 = - (r_ymax + 1) * char_y_size;
winr.box.y1 = - r_ymin * char_y_size;
wimp_force_redraw(&winr);
/* reset redraw info */
r_xmin = 32768;
r_xmax = 0;
r_ymax = 0;
r_ymin = 32768;
xf_needs_redraw = FALSE;
}
}
/* posn. cursor, ignore invalid positions */
void xf_gotoxy(int x, int y)
{
if (x >= 0 && x < max_x_size && y >= 0 && y < max_y_size)
{
xf_cursor_x = x;
xf_cursor_y = y;
}
}
/* scroll window */
void xf_scroll(void)
{
char *i, *j;
wimp_box wbox;
/* scroll array up */
for (i = screen, j = screen + max_x_size; j < (screen + \
max_x_size * max_y_size); *i = *j, i++, j++);
/* clear last line */
for (; i < j; i++)
*i = 0;
/* scroll window contents */
wbox.x0 = 0;
wbox.x1 = max_x_size * char_x_size;
wbox.y1 = - char_y_size;
wbox.y0 = - max_y_size * char_y_size;
wimp_blockcopy(xf_main_wind, &wbox, 0,-(max_y_size - 1) * char_y_size);
xf_invalidate_screen(0, max_y_size - 2, max_x_size, max_y_size - 1);
xf_force_redraw();
}
/* cursor to next line */
void xf_next_line(void)
{
xf_cursor_y++;
if (xf_cursor_y == max_y_size)
{
xf_cursor_y--;
xf_scroll();
}
/* this is necessary for I/O intensive tasks */
}
/* cursor to previous line */
void xf_previous_line(void)
{
if (xf_cursor_y > 0)
xf_cursor_y--;
}
/* create a new line */
void xf_new_line(void)
{
xf_next_line();
xf_gotoxy(0, xf_cursor_y);
xf_find_caret();
/* for I/O intensive tasks... */
xf_event_process();
}
/* advance cursor by 1 pos. */
void xf_next_char(void)
{
xf_cursor_x++;
if (xf_cursor_x == max_x_size)
{
xf_cursor_x = 0;
xf_next_line();
}
}
/* back cursor 1 char */
void xf_previous_char(void)
{
xf_cursor_x--;
if (xf_cursor_x < 0)
{
xf_cursor_x = max_x_size - 1;
xf_previous_line();
}
}
/* delete character before cursor */
void xf_back_del()
{
int i;
int adr;
if (xf_cursor_x > 0)
{
xf_cursor_x--;
adr = xf_cursor_y * max_x_size;
/* shift line to the right */
for (i = xf_cursor_x; i < max_x_size - 1; i++)
screen[adr + i] = screen[adr + i + 1];
screen[adr + max_x_size - 1] = 0;
xf_invalidate_screen(xf_cursor_x, xf_cursor_y, max_x_size, xf_cursor_y);
}
xf_set_caret();
}
/* print a character to cursor pos., no redrawing forced. */
/* check for control chars */
void xf__putc(int c)
{
static BOOL in_gotoxy = FALSE;
static int numpars = 0;
static int params[2];
/* collect coords if in a gotoxy-sequence */
if (in_gotoxy)
{
params[numpars++] = c;
if (numpars == 2)
{
xf_gotoxy(params[0], params[1]);
in_gotoxy = 0;
}
}
else
{
/* otherwise process character: */
switch (c)
{
/* cursor down (newline) */
case 10:
xf_new_line();
break;
/* carriage return */
case 13:
xf_gotoxy(0, xf_cursor_y);
break;
/* cursor up */
case 11:
xf_previous_line();
break;
/* cursor back 1 char */
case 8:
xf_previous_char();
break;
/* cursor advance 1 char */
case 9:
xf_next_char();
break;
/* clear screen */
case 12:
xf_clear_screen();
break;
/* home cursor */
case 30:
xf_gotoxy(0,0);
break;
/* position cursor */
case 31:
in_gotoxy = TRUE;
numpars = 0;
break;
/* delete char to left of cursor */
case 127:
xf_back_del();
break;
/* or just print the char */
default:
if (c > 31)
{
screen[xf_cursor_x + xf_cursor_y * max_x_size] = (char) c;
xf_invalidate_screen(xf_cursor_x, xf_cursor_y, xf_cursor_x, \
xf_cursor_y);
xf_next_char();
}
}
}
}
/* print a char to cursor os. redrawing forced */
void xf_putchar(int c)
{
xf__putc(c);
xf_force_redraw();
}
/* print a string to cursor pos. */
void xf_puts(char *string)
{
int i;
for (i = 0; i < strlen(string); i++)
xf__putc(string[i]);
xf_force_redraw();
}
/* return a character from the board */
int xf_getchar(void)
{
int tmpchar;
BOOL valid = FALSE;
xf_find_caret();
/* don't process null-events while in here */
event_setmask(WKEYMASK);
/* continue until we can process the key */
while (!valid)
{
/* wait for a keypress from user */
while ((tmpchar = popkey()) == -1)
{
xf_event_process();
}
if (tmpchar > 0x100)
wimp_processkey(tmpchar);
else
valid = TRUE;
}
event_setmask(WSTDMASK);
return tmpchar;
}
/* clear virtual screen */
void xf_clear_screen(void)
{
int i;
/* clear screen */
for (i=0; i < max_x_size * max_y_size; i++)
screen[i] = 0;
/* invalidate total screen */
xf_invalidate_screen(0, 0, max_x_size, max_y_size);
xf_force_redraw();
/* reset cursor positions */
xf_gotoxy(0, 0);
}
/* initialize virtual screen */
int xf_init_screen(wimp_w window, screenvar *svar)
{
wimp_winfo *winfo = (wimp_winfo *) winfo_buffer;
int win_x_size;
int win_y_size;
winfo->w = window;
wimp_get_wind_info(winfo);
/* get maximum wrk area extent */
win_x_size = winfo->info.ex.x1 - winfo->info.ex.x0;
win_y_size = winfo->info.ex.y1 - winfo->info.ex.y0;
/* set global variables */
max_x_size = win_x_size / (svar->xppc << svar->xeigh);
max_y_size = win_y_size / (svar->yppc << svar->yeigh);
/* allocate screen memory */
screen = malloc(max_x_size*max_y_size + 1);
if (screen == NULL)
return FALSE;
xf_clear_screen();
return TRUE;
}
/*** window routines ***/
/* create window, don't open */
int xf_create_window(char *name, wimp_w *handle)
{
wimp_wind *window;
window = template_syshandle(name);
colors = (3 << 4) | window->colours[wimp_WCWKAREAFORE] ^
window->colours[wimp_WCWKAREABACK] ;
if (window == 0)
return FALSE;
return (wimpt_complain(wimp_create_wind(window, handle)) == 0);
}
/* open window, low level */
int xf_w_open_window(wimp_openstr *ostr)
{
return (wimpt_complain(wimp_open_wind(ostr)) == 0);
}
/* open window, high level */
int xf_open_window(wimp_w wind)
{
wimp_wstate win;
wimp_openstr ostr;
screenvar *ssize;
int wxsize, wysize;
int xpos, ypos;
int result;
/* tell event system about it */
win_activeinc();
/* get screensize */
ssize = xf_get_screen_size();
/* build wimp_openstr */
wimp_get_wind_state(wind, &win);
ostr = win.o;
ostr.behind = -1;
ostr.x = 0;
ostr.y = 0;
/* get size of visible work area */
wxsize = ostr.box.x1 - ostr.box.x0;
wysize = ostr.box.y1 - ostr.box.y0;
/* pos. of window on screen */
xpos = ((ssize->xphys << ssize->xeigh) - wxsize)/2;
ypos = ((ssize->yphys << ssize->yeigh) - wysize)/2;
/* center window on screen */
ostr.box.x0 = xpos;
ostr.box.x1 = xpos + wxsize;
ostr.box.y0 = ypos;
ostr.box.y1 = ypos + wysize;
/* open window on screen */
result = xf_w_open_window(&ostr);
/* init underlying screen */
xf_init_screen(wind, ssize);
return (result != 0);
}
/*** special window routines ***/
static void xf_redraw_main_window(wimp_w window)
{
BOOL more;
wimp_redrawstr rwind;
int ox,oy;
int top, left, right, bottom;
int i,j;
int curchar;
/* get screen coordinates of visible area */
rwind.w = window;
wimpt_noerr(wimp_redraw_wind(&rwind, &more));
ox = rwind.box.x0 - rwind.scx;
oy = rwind.box.y1 - rwind.scy;
/* while there's still something to redraw */
while (more)
{
/* compute rectangle to redraw */
top = rwind.g.y1 + 1 - oy;
left = rwind.g.x0 - ox;
right = rwind.g.x1 - ox;
bottom = rwind.g.y0 + 1 - oy;
/* compute textgrid coordinates */
top = (-top) / char_y_size;
left = left /char_x_size;
right = right / char_x_size;
bottom = (-bottom) / char_y_size;
wimp_setcolour(colors);
/* redraw rectangle */
for(j = top; j <= bottom; j++)
{
for(i = left; i <= right; i++)
{
if ((curchar = screen[j * max_x_size + i]) > 0)
{
bbc_move(ox + (i * char_x_size), oy-1-(j * char_y_size));
bbc_vdu(curchar);
}
}
}
/* get next next rectangle */
wimp_get_rectangle(&rwind, &more);
}
xf_set_caret();
}
/*** event routines ***/
/* event handler for main window */
void xf_main_event_handler(wimp_eventstr *event, void *handle)
{
handle = handle; /* we get it, but there's no need for it */
/* handle the event */
switch (event->e)
{
case wimp_EREDRAW:
xf_redraw_main_window(event->data.o.w);
break;
case wimp_EOPEN:
xf_w_open_window(&event->data.o);
break;
case wimp_ECLOSE:
xf_closedown();
break;
case wimp_EKEY:
xf_handle_key(event->data.key.chcode);
break;
case wimp_EBUT:
if (event->data.but.m.bbits & (wimp_BLEFT | wimp_BRIGHT))
xf_set_caret();
break;
default:;
/* ignore */
}
}
/* event handler for the menu */
void xf_menu_handler(void *handle, char *sel)
{
handle = handle;
switch (sel[0])
{
case XF_INFO:
xf_prog_info();
break;
case XF_QUIT:
xf_closedown();
break;
}
}
/*** Wimp frontend initialisation routine ***/
int xf_init(void)
{
initing = TRUE;
/* init event system */
event_setmask(WSTDMASK);
win_init();
/* start task */
wimp_taskinit("XLisp interpreter", &wimp_version, &task_handle);
/* setup system runtime */
systime.tms_utime = 0;
systime.tms_stime = 0;
systime.tms_cutime = 0;
systime.tms_cstime = 0;
sys_timeslp = get_time();
/* secure floating point op's */
wimp_save_fp_state_on_poll();
/* initialize resources */
res_init("XLisp");
template_init();
dbox_init();
loadpath = strdup(getenv("Xlisp$lspPath"));
/* the main window */
if (!xf_create_window("MainWindow", &xf_main_wind))
return FALSE;
/* setup event handler for window, set 'handle' to 0... */
win_register_event_handler(xf_main_wind, xf_main_event_handler, 0);
/* the menu tree */
if ((xf_menu = menu_new("XLisp",">Info,Quit")) == NULL)
return FALSE;
/* attach menu to window */
if (!event_attachmenu(xf_main_wind, xf_menu, xf_menu_handler, 0))
return FALSE;
xf_open_window(xf_main_wind);
xf_set_caret();
/* init the keyboard buffer */
init_keybuffer();
initing = FALSE;
return TRUE;
}
/*+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
+*+++++++++++++++++++ WIMP interfacing code end +++++++++++++++++++++++++++
+*+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++*/
/* -- external variables */
extern FILEP tfp;
extern LVAL xlenv, xlfenv, xldenv;
/* -- local variables */
static char lbuf[BUFSIZ];
static int lpos[BUFSIZ];
int lposition; /* export this */
static int lindex;
static int lcount;
char *xfgets(char*, int, FILEP);
char read_keybd(void);
void osx_check(int);
void init_tty(void);
void xinfo(void);
/* xsystem - run a process, sending output (if any) to stdout/stderr */
LVAL
xsystem()
{
extern LVAL true;
char *comstr;
LVAL command;
int result;
time_t stime;
/* get shell command */
command = xlgastring();
xllastarg();
comstr = (char *) getstring(command);
/* start external process, measure runtime internally */
stime = get_time();
result = system(comstr);
systime.tms_stime += get_time() - stime;
return (result ? cvfixnum(result) : true);
}
/* osinit - initialize OS for XLISP */
VOID osinit (char *banner)
{
if (xf_init() != TRUE)
exit (-1);
xf_puts(banner);
xf_putchar('\n');
init_tty();
lindex = 0;
lcount = 0;
}
/* -- osfinish - clean up before returning to the operating system */
VOID osfinish()
{
xf_closedown();
}
/* -- xoserror - print an error message */
VOID xoserror(msg)
char *msg;
{
werr(0, "error: %s\n", msg );
}
/* osrand - return next random number in sequence */
long osrand(rseed)
long rseed;
{
long k1;
/* make sure we don't get stuck at zero */
if (rseed == 0L) rseed = 1L;
/* algorithm taken from Dr. Dobbs Journal, November 1985, page 91 */
k1 = rseed / 127773L;
if ((rseed = 16807L * (rseed - k1 * 127773L) - k1 * 2836L) < 0L)
rseed += 2147483647L;
/* return a random number between 0 and MAXFIX */
return rseed;
}
/* fix names in the form "[path.]bla.lsp" to become "[path.]lsp.bla" */
char *fixname(const char *name)
{
char *hname, *hhn;
char *retval;
int i;
char c[FILENAMELEN];
char fix[5];
retval = strdup((char *)name);
hname = retval + (strlen(retval)-3);
i = strlen(retval);
if (i < 3)
return retval;
strcpy(fix, stolower(hname));
/* lsp postfix? */
if (strcmp(fix, "wks") == 0 || strcmp(fix, "lsp") == 0)
{
hhn = hname - 1;
hname -= 2;
while(*hname != '.' && hname > retval)
--hname;
if (*hname == '.')
hname++;
/* then turn it into a prefix for the filename */
strncpy(c, hname, (int) (hhn - hname));
strcpy (hname, strcat(fix,"."));
hname+=4;
strcpy (hname, c);
retval[i] = '\0';
}
return retval;
}
/* open a file trying given and fixed name */
FILE *osopen (const char *name, const char *mode)
{
int j;
FILE *retval = NULL;
char tmppath[PATHBUF];
char *nname = NULL;
/* eval curdir every single time, it may change! */
curdir = getenv("XLisp$WorkDir");
nname = (char *)name;
j = 0;
while (retval == NULL && j<2)
{
/* first pass: try normal filename */
/* on the second pass fix the postfix-problem */
if (j==1)
nname = fixname(name);
++j;
tmppath[0] = 0;
if (curdir != NULL)
{
strcpy(tmppath, curdir);
tmppath[strlen(curdir)] = 0;
}
retval = fopen(strcat(tmppath, nname), mode);
}
if (nname != name)
free(nname);
return retval;
}
/* open a file, searching along XLisp$lspPath */
FILE *ospopen(char *name, int ascii)
{
char tmppath[PATHBUF];
char *ptr;
char *hname;
int i,j;
FILE *retval = NULL;
/* no postfix->prefix translation if absolute path was given. */
/* check for ansolute pathname: */
/* root, user or current dir */
if (name[0] == '$' || name[0] == '@' || name[0] == '&')
retval = fopen(name, "r");
/* absolute pathname, starting with a FS specifier */
if (retval == NULL)
{
i = 0;
while (i < strlen(name) && retval == NULL)
{
if (name[i] == ':')
retval = fopen(name, "r");
i++;
}
}
/* try loadpaths */
hname = name;
j=0;
while (retval == NULL && j<2)
{
/* first pass: try normal filename */
/* on the second pass fix the postfix-problem */
if (j==1)
hname = fixname(name);
++j;
ptr = loadpath;
while ((ptr <= loadpath + strlen(loadpath)) && retval == NULL)
{
i = 0;
while (*ptr != ',' && ptr < loadpath + strlen(loadpath))
{
tmppath[i] = *ptr;
++i;
++ptr;
}
tmppath[i] = 0;
if (tmppath[0] == 0)
retval = osopen(name, "r");
else
retval = fopen(strcat(tmppath, hname), "r");
++ptr;
}
}
if (hname != name)
free(hname);
return retval;
}
/* rename argument file as backup, return success name */
/* For new systems -- if cannot do it, just return TRUE! */
int renamebackup(filename)
char *filename;
{
return TRUE;
}
/* -- ostgetc - get a character from the terminal */
int ostgetc(void)
{
while(--lcount < 0 )
{
if ( xfgets(lbuf,BUFSIZ,stdin) == NULL )
return( EOF );
lcount = strlen( lbuf );
if (tfp!=CLOSED) OSWRITE(lbuf,1,lcount,tfp);
lindex = 0;
lposition = 0;
}
return( lbuf[lindex++] );
}
/* -- ostputc - put a character to the terminal */
VOID ostputc(ch)
int ch;
{
/* -- output the character */
xf_putchar(ch);
/* -- output the char to the transcript file */
if ( tfp != CLOSED )
OSPUTC( ch, tfp );
}
/* -- osflush - flush the terminal input buffer */
VOID osflush()
{
init_keybuffer();
lindex = lcount = lposition = 0;
}
void oscheck()
{
xf_event_process();
}
void osx_check(int ch)
{
switch (ch) {
case '\003':
xltoplevel(); /* control-c */
case '\007':
xlcleanup(); /* control-g */
case '\020':
xlcontinue(); /* control-p */
case '\024': /* control-t */
xinfo();
xf_puts("\n> ");
}
}
/* -- ossymbols - enter os-specific symbols */
VOID ossymbols()
{
}
/* xinfo - show information on control-t */
VOID xinfo()
{
extern int nfree, gccalls;
extern long total;
char tymebuf[100];
time_t tyme;
char buf[500];
time(&tyme);
strcpy(tymebuf, ctime(&tyme));
tymebuf[19] = '\0';
sprintf(buf,"\n[ %s Free: %d, GC calls: %d, Total: %ld ]",
tymebuf, nfree,gccalls,total);
errputstr(buf);
}
/* xflush - flush the input line buffer and start a new line */
VOID xflush()
{
osflush();
ostputc('\n');
}
char read_keybd()
{
return(xf_getchar());
}
/* xgetkey - get a key from the keyboard */
LVAL xgetkey()
{
xllastarg();
return (cvfixnum((FIXTYPE)read_keybd()));
}
VOID xlresetint(dummy)
int dummy;
{
signal(SIGINT, xlresetint);
xltoplevel();
}
void init_tty(void)
{
signal(SIGINT, xlresetint);
}
char *xfgets(s, n, iop)
char *s;
int n;
register FILE *iop;
{
register c;
register char *cs;
cs = s;
while (--n>0 && (c = read_keybd()) != EOF) {
switch(c) {
case '\003' : /* CTRL-c */
case '\007' : /* CTRL-g */
case '\020' : /* CTRL-p */
case '\024' : osx_check(c); /* CTRL-t */
n++;
break;
case 8 :
case 127 : if (cs==s) break; /* not before beginning */
stdputstr("\x08 \x08");
n+=2;
cs--;
break;
case '\r' : c = '\n';
*cs++ = c;
default : if (c >= ' ')
*cs++ = c; /* character */
ostputc(c);
}
if (c=='\n') break;
}
if (c == EOF && cs==s) return(NULL);
*cs = '\0';
return(s);
}
#ifdef TIMES
/***********************************************************************/
/** **/
/** Time and Environment Functions **/
/** **/
/***********************************************************************/
unsigned long ticks_per_second() { return((unsigned long) HZ); }
unsigned long run_tick_count()
{
return((unsigned long) systime.tms_utime + systime.tms_stime );
return 0;
}
unsigned long real_tick_count()
{ /* Real time */
return((unsigned long) get_time());
}
LVAL xtime()
{
LVAL expr, result;
unsigned long tm, rtm;
double dtm, rdtm;
/* get the expression to evaluate */
expr = xlgetarg();
xllastarg();
tm = run_tick_count();
rtm = real_tick_count();
result = xleval(expr);
tm = run_tick_count() - tm;
rtm = real_tick_count() - rtm;
dtm = (tm > 0) ? tm : -tm;
rdtm = (rtm > 0) ? rtm : -rtm;
sprintf(buf, "CPU %.2f sec., Real %.2f sec.\n", dtm / ticks_per_second(),
rdtm / ticks_per_second());
trcputstr(buf);
return(result);
}
LVAL xruntime()
{
xllastarg();
return(cvfixnum((FIXTYPE) run_tick_count()));
}
LVAL xrealtime()
{
xllastarg();
return(cvfixnum((FIXTYPE) real_tick_count()));
}
#endif